perm filename TEST2.SAI[S,HE] blob
sn#658971 filedate 1982-05-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00050 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00008 00002 BEGIN "TEST2"
C00011 00003 IF EQU(COMMAND,"l") THEN BEGIN comment load channel and subchannel
C00012 00004 ELSE IF EQU(COMMAND,"o") THEN comment Output octal instruction
C00013 00005 ELSE IF EQU(COMMAND,"kludge") THEN comment Test bit map flaw
C00016 00006 ELSE IF EQU(COMMAND,"uset") THEN comment set parameters for u command
C00017 00007 ELSE IF EQU(COMMAND,"u") THEN comment do an unpacked read
C00018 00008 ELSE IF (EQU(COMMAND,"pr") comment read in one line in packed mode
C00020 00009 ELSE IF EQU(COMMAND,"pw") THEN comment Do a packed write
C00022 00010 ELSE IF EQU(COMMAND,"loopp") THEN comment do a packed read 101 times
C00023 00011 ELSE IF EQU(COMMAND,"looprp") THEN comment do a packed read with bytes reveresed 101 times
C00025 00012 ELSE IF EQU(COMMAND,"set") THEN comment load several channels and subchannels
C00026 00013 ELSE IF EQU(COMMAND,"e") THEN comment Erase current channel
C00027 00014 ELSE IF EQU(COMMAND,"c") THEN comment Checkerboard pattern
C00028 00015 ELSE IF EQU(COMMAND,"r") THEN comment Reverse checkerboard patten
C00029 00016 ELSE IF EQU(COMMAND,"t") THEN comment Run the four internal tests
C00031 00017 ELSE IF EQU(COMMAND,"i") THEN comment Select the internal tests, but don't run any
C00032 00018 ELSE IF EQU(COMMAND,"s") THEN comment Set inputs to video lookup tables
C00033 00019 ELSE IF EQU(COMMAND,"z") THEN comment Check zoom and pan
C00035 00020 ELSE IF EQU(COMMAND,"m") THEN comment Load lookup table to view LSBs
C00036 00021 ELSE IF EQU(COMMAND,"rl") THEN comment Test lookup table with random data
C00038 00022 ELSE IF EQU(COMMAND,"rmset") THEN comment Set parameters for memory test
C00040 00023 ELSE IF EQU(COMMAND,"rm") THEN comment Test memory in selected channels
C00046 00024 ELSE IF EQU(COMMAND,"mapin") THEN comment Read back lookup table
C00047 00025 ELSE IF EQU(COMMAND,"ipcmap") THEN comment Read back ipc lookup table
C00048 00026 ELSE IF EQU(COMMAND,"b") THEN comment Load lookup table to view one bit
C00049 00027 ELSE IF EQU(COMMAND,"k") THEN comment Read back cursor registers
C00050 00028 ELSE IF EQU(COMMAND,"kloop") THEN comment Repeat readback of cursor registers until FUNA and FUNB both set
C00051 00029 ELSE IF EQU(COMMAND,"candy") THEN comment pant, drool
C00052 00030 ELSE IF EQU(COMMAND,"d") THEN comment Digitize
C00054 00031 ELSE IF EQU(COMMAND,"p") THEN comment Test individual bit planes
C00055 00032 ELSE IF EQU(COMMAND,"move") THEN comment Move cursor
C00056 00033 ELSE IF EQU(COMMAND,"g") THEN comment Graph intensity distribution
C00058 00034 ELSE IF EQU(COMMAND,"a") THEN comment Test max min logic of analyzer
C00059 00035 ELSE IF EQU(COMMAND,"ah") THEN comment Print out nonzero values using
C00060 00036 ELSE IF EQU(COMMAND,"w") THEN comment Do LWM instruction
C00061 00037 ELSE IF EQU(COMMAND,"ipcs") THEN comment Switch inputs to ipc lookup tables
C00062 00038 ELSE IF EQU(COMMAND,"ipcc") THEN comment IPC control
C00063 00039 ELSE IF EQU(COMMAND,"ipcm") THEN comment Set IPC control mode
C00064 00040 ELSE IF EQU(COMMAND,"ipcw") THEN comment Cause ipc to write into memory
C00065 00041 ELSE IF EQU(COMMAND,"out") THEN comment Change output from look up tables
C00066 00042 ELSE IF EQU(COMMAND,"cout") THEN comment Change cursor oerlay map
C00067 00043 ELSE IF EQU(COMMAND,"ck") THEN comment Clear all channels, make drk bkg, draw checkerboard
C00068 00044 ELSE IF EQU(COMMAND,"bump") THEN comment Repetitive interface exercise
C00069 00045 ELSE IF EQU(COMMAND,"fill") THEN comment Fill buffer with bytes do packed mode output to grinnel
C00072 00046 ELSE IF EQU(COMMAND,"rect") THEN Comment use rectangular update mode for output
C00075 00047 ELSE IF EQU(COMMAND,"!") THEN comment Print commands, listed by unit affected
C00079 00048 ELSE IF EQU(COMMAND,"?") THEN comment Print help message
C00083 00049 ELSE IF EQU(COMMAND,"q") THEN FINISHED ← TRUE
C00084 00050 ELSE PRINT("Type ? for help.",crlf)
C00085 ENDMK
C⊗;
BEGIN "TEST2"
COMMENT REQUIRE "RR" COMPILER_SWITCHES;
COMMENT Of course, that doesn't work, so...;
REQUIRE "Compile me with RR compiler switch!" MESSAGE;
COMMENT Allows us to check the channels of the Grinnell.;
DEFINE TO="STEP 1 UNTIL";
DEFINE DEBUG="comment";
DEFINE ! = "COMMENT";
DEFINE CRLF = " ('15&'12) ";
REQUIRE "GRNHDR[HDR,HE]" SOURCE_FILE;
REQUIRE "GRNDEF[HDR,HE]" SOURCE_FILE;
REQUIRE "CRDHDR[HDR,HE]" SOURCE_FILE;
REQUIRE "ELFHDR[HDR,HE]" SOURCE_FILE;
INTEGER ULINE,UEL,UNUM; COMMENT FOR "U" AND "USET" CMDS;
BOOLEAN USHOW;
INTEGER TDATA,TMOD; COMMENT For "rm" cmd (memory test)--indicates how data is generated;
DEFINE RND="0",ONE="1",ZRO="2",CNT="3"; COMMENT types of memory test data;
BOOLEAN TPACKED; COMMENT Indicates whether memory test is done in packed or un-
packed mode;
BOOLEAN TREAD,TWRITE; COMMENT Whether to read, write on memory test;
STRING COMMAND;
INTEGER CHAN, SUBCHAN;
BOOLEAN FINISHED;
INTEGER DIR;
PROCEDURE CHEKER(BOOLEAN SWITCH);
BEGIN "CHEKER"
INTEGER E,L;
GRNINS(LEA LOR 0); GRNINS(LLA LOR 0); COMMENT start at lower left corner;
GRNINS(LEB LOR 16); COMMENT element increment;
GRNINS(LLB LOR 2); COMMENT line increment;
GRNINS(LEC LOR 0); COMMENT element start pos.;
GRNINS(LUM LOR E1); COMMENT update el after each write;
GRNINS(LWM LOR BITH LOR BITW); COMMENT no Z bit, Double height,
Double width;
FOR L ← 0 TO 511 DO COMMENT for 512 lines;
BEGIN
FOR E ← 0 TO 63 DO COMMENT for 64 8-bit chunks;
BEGIN
GRNINS(WGD LOR (IF SWITCH THEN '125 ELSE '252))
END;
GRNINS(SLU LOR L1 LOR E0); COMMENT incr line by 1, set el←0;
DEBUG PRINT("Wrote line ",L," ");
SWITCH ← NOT SWITCH COMMENT to alternate lines;
END;
BUFOUT
END "CHEKER";
GRNINI;
FINISHED ← FALSE;
WHILE NOT FINISHED DO
BEGIN
PRINT("Command: ");
COMMAND ← INCHWL;
IF EQU(COMMAND,"l") THEN BEGIN comment load channel and subchannel;
PRINT("Channel: "); CHAN ← 1 LSH CVD(inchwl);
PRINT("Subchannel: "); SUBCHAN ← CVO(inchwl);
GRNINS(LDC LOR CHAN);
GRNINS(LSM LOR SUBCHAN);
END
ELSE IF EQU(COMMAND,"o") THEN comment Output octal instruction;
BEGIN "OCTAL"
PRINT("INSTRUCTION: ");
GRNINS(CVO(INCHWL)); comment This is the way Tom Kappeler likes
to use the Grinnell;
BUFOUT;
END "OCTAL"
ELSE IF EQU(COMMAND,"kludge") THEN comment Test bit map flaw;
BEGIN "KLUDGE"
INTEGER ARRAY BITMAP[0:255];
INTEGER I,J, CARD, TABL; comment THATS A CARD TABLE...;
PRINT("CARD: "); CARD ← CVO(INCHWL);
PRINT("TABLE: "); TABL ← CVO(INCHWL);
COMMENT Make card 0 table 0 just distinguish '364 and '365;
ARRCLR(BITMAP,0); BITMAP['365] ← '20;
IFVCMAP(CARD,TABL,BITMAP);
COMMENT Fill channel 0 with alternating '364 and '365;
GRNINS(LDC LOR 1); GRNINS(LSM LOR '377);
GRNINS(LEA LOR 0); GRNINS(LLA LOR 0); COMMENT start at lower left corner;
GRNINS(LEB LOR 1); COMMENT element increment;
GRNINS(LLB LOR 1); COMMENT line increment;
GRNINS(LEC LOR 0); COMMENT element start pos.;
GRNINS(LUM LOR E1); COMMENT update el after each write;
GRNINS(LWM LOR BITH LOR BITW); COMMENT no Z bit, Double height,
Double width;
FOR I ← 1 TO 512 DO
BEGIN
FOR J ← 1 TO 128 DO
BEGIN
GRNINS(WID LOR '364);
GRNINS(WID LOR '364);
GRNINS(WID LOR '365);
GRNINS(WID LOR '365)
END;
GRNINS(SLU LOR L1 LOR E0) COMMENT incr line by 1, set el←0;
END;
COMMENT Now switch card 0 table 0 to channel 0;
SWITCHCHAN(0,0,0,0); COMMENT it really switches all of them...;
BUFOUT
END "KLUDGE"
ELSE IF EQU(COMMAND,"uset") THEN comment set parameters for u command;
BEGIN
PRINT("Line: "); ULINE ← CVD(INCHWL);
PRINT("Element: "); UEL ← CVD(INCHWL);
PRINT("Horizontal?:"); DIR←IF EQU(INCHWL,"y") THEN E1 ELSE L1;
PRINT("Number of pixels: "); UNUM ← CVD(INCHWL);
PRINT("Display the data?"); USHOW ← EQU(INCHWL,"y");
END
ELSE IF EQU(COMMAND,"u") THEN comment do an unpacked read;
BEGIN
INTEGER ARRAY DATA[1:UNUM]; INTEGER I;
GRNINS(LEA LOR UEL);
GRNINS(LLA LOR ULINE);
GRNINS(LEB LOR 1);GRNINS(LLB LOR '777);
GRNINS(LUM LOR DIR); COMMENT update el after each byte;
GRNINS(SPD LOR READBACK);
GRNIN(LOCATION(DATA[1]),UNUM);
IF USHOW THEN FOR I ← 1 TO UNUM DO PRINT(DATA[I]," ");
END
ELSE IF (EQU(COMMAND,"pr") comment read in one line in packed mode;
OR EQU(COMMAND,";")) THEN comment semi is close to "return" on kbd;
BEGIN
INTEGER ARRAY DATA[0:UNUM-1]; INTEGER I;
INTEGER HAFCOUNT;
HAFCOUNT ← (UNUM LSH -1) + (UNUM LAND 1); comment ceil(unum/2);
GRNINS(LEA LOR UEL);
GRNINS(LLA LOR ULINE);
GRNINS(LEB LOR 1);GRNINS(LLB LOR NEG1);
GRNINS(LUM LOR DIR); COMMENT update el after each write;
GRNINS(SPD LOR READBACK);
GRNIN(LOCATION(DATA[0]),HAFCOUNT,BYTEPACK);
IF USHOW THEN FOR I ← 0 TO UNUM-1 DO
PRINT((DATA[I LSH -1] LAND (IF (I LAND 1) THEN '377
ELSE '177400)) LSH (IF (I LAND 1) THEN 0 ELSE -8)," ");
END
ELSE IF EQU(COMMAND,"pw") THEN comment Do a packed write;
BEGIN
INTEGER NBYTES,LINE,EL,I;
PRINT("Number of bytes: "); NBYTES ← CVD(INCHWL);
PRINT("Line number: "); LINE ← CVD(INCHWL);
PRINT("Element number: "); EL ← CVD(INCHWL);
COMMENT Set up line and element registers, and updating by adding
one to element, i.e. horizontal lines are written;
GRNINS(LEA LOR EL);
GRNINS(LLA LOR LINE);
GRNINS(LEB LOR 1);
GRNINS(LLB LOR 1);
GRNINS(LUM LOR E1); COMMENT Ea←Ea+Eb;
GRNINS(LWM LOR BITZ);
COMMENT Now do the byte-unpacking instructions;
GRNINS(SPD LOR BYTEUNPACK);
GRNINS(LPR LOR BYTEIMAGE LOR
TRUNC*(NBYTES MOD 2) LOR COMMENT Truncate if odd;
(((NBYTES + 1) DIV 2) MOD 256)); COMMENT ceil(nbytes/2) 256→0;
COMMENT Finally, put out the data;
FOR I ← 0 STEP 2 UNTIL NBYTES-1 DO
GRNINS(((I LAND '377) LSH 8) LOR ((I+1) LAND '377));
IF (NBYTES MOD 2)≠0 THEN GRNINS(((NBYTES-1) LAND '377) LSH 8);
BUFOUT;
END
ELSE IF EQU(COMMAND,"loopp") THEN comment do a packed read 101 times;
BEGIN
INTEGER ARRAY DATA[0:UNUM-1]; INTEGER I;
INTEGER HAFCOUNT;
HAFCOUNT ← (UNUM LSH -1) + (UNUM LAND 1); comment ceil(unum/2);
GRNINS(LEA LOR UEL);
GRNINS(LLA LOR ULINE);
GRNINS(LEB LOR 1);GRNINS(LLB LOR '777);
GRNINS(LUM LOR DIR); COMMENT update el after each byte;
GRNINS(SPD LOR READBACK);
FOR I ← 0 TO 100 DO
GRNIN(LOCATION(DATA[0]),HAFCOUNT,BYTEPACK);
IF USHOW THEN FOR I ← 0 TO UNUM-1 DO
PRINT((DATA[I LSH -1] LAND (IF (I LAND 1) THEN '377
ELSE '177400)) LSH (IF (I LAND 1) THEN 0 ELSE -8)," ");
END
ELSE IF EQU(COMMAND,"looprp") THEN comment do a packed read with bytes reveresed 101 times;
BEGIN
INTEGER ARRAY DATA[0:UNUM-1]; INTEGER I;
INTEGER HAFCOUNT;
HAFCOUNT ← (UNUM LSH -1) + (UNUM LAND 1); comment ceil(unum/2);
GRNINS(LEA LOR UEL);
GRNINS(LLA LOR ULINE);
GRNINS(LEB LOR 1);GRNINS(LLB LOR 1);
GRNINS(LUM LOR DIR); COMMENT update el after each byte;
GRNINS(SPD LOR READBACK);
FOR I ← 0 TO 100 DO
GRNIN(LOCATION(DATA[0]),HAFCOUNT,BYTEPACK LOR REV);
IF USHOW THEN FOR I ← 0 TO UNUM-1 DO
PRINT((DATA[I LSH -1] LAND (IF (I LAND 1) THEN '377
ELSE '177400)) LSH (IF (I LAND 1) THEN 0 ELSE -8)," ");
END
ELSE IF EQU(COMMAND,"set") THEN comment load several channels and subchannels;
BEGIN
PRINT("Channel: "); CHAN ← CVO(inchwl);
PRINT("Subchannel: "); SUBCHAN ← CVO(inchwl);
GRNINS(LDC LOR CHAN);
GRNINS(LSM LOR SUBCHAN);
END
ELSE IF EQU(COMMAND,"e") THEN comment Erase current channel;
BEGIN
GRNINS(ERS);
BUFOUT
END
ELSE IF EQU(COMMAND,"c") THEN comment Checkerboard pattern;
BEGIN
CHEKER(TRUE)
END
ELSE IF EQU(COMMAND,"r") THEN comment Reverse checkerboard patten;
BEGIN
CHEKER(FALSE)
END
ELSE IF EQU(COMMAND,"t") THEN comment Run the four internal tests;
BEGIN
GRNINS(SPD LOR TEST);
BEGIN INTEGER I; FOR I←0 TO 3 DO GRNINS(LPA LOR I) END;
BUFOUT
END
ELSE IF EQU(COMMAND,"t0") THEN comment Run the four internal tests;
BEGIN
GRNINS(SPD LOR TEST);
BEGIN INTEGER I; FOR I←0 TO 0 DO GRNINS(LPA LOR I) END;
BUFOUT
END
ELSE IF EQU(COMMAND,"t1") THEN comment Run the four internal tests;
BEGIN
GRNINS(SPD LOR TEST);
BEGIN INTEGER I; FOR I←1 TO 1 DO GRNINS(LPA LOR I) END;
BUFOUT
END
ELSE IF EQU(COMMAND,"t2") THEN comment Run the four internal tests;
BEGIN
GRNINS(SPD LOR TEST);
BEGIN INTEGER I; FOR I←2 TO 2 DO GRNINS(LPA LOR I) END;
BUFOUT
END
ELSE IF EQU(COMMAND,"t3") THEN comment Run the four internal tests;
BEGIN
GRNINS(SPD LOR TEST);
BEGIN INTEGER I; FOR I←3 TO 3 DO GRNINS(LPA LOR I) END;
BUFOUT
END
ELSE IF EQU(COMMAND,"i") THEN comment Select the internal tests, but don't run any;
BEGIN
GRNINS(SPD LOR TEST);
BUFOUT;
END
ELSE IF EQU(COMMAND,"s") THEN comment Set inputs to video lookup tables;
BEGIN
INTEGER CARD, SOURCEA, SOURCEB, SOURCEC;
PRINT("CARD: "); CARD ← CVO(INCHWL);
PRINT("SOURCEA: "); SOURCEA ← CVO(INCHWL);
PRINT("SOURCEB: "); SOURCEB ← CVO(INCHWL);
PRINT("SOURCEC: "); SOURCEC ← CVO(INCHWL);
SwitchChan(card,SOURCEA, SOURCEB, SOURCEC);
bufout;
END
ELSE IF EQU(COMMAND,"z") THEN comment Check zoom and pan;
BEGIN
INTEGER ZF, EL, LN, CONTROL_BITS;
CONTROL_BITS ← 0;
PRINT("CHAN: "); CHAN ← CVO(INCHWL);
PRINT("ZOOM FACTOR (0-3) "); ZF ← CVO(INCHWL);
PRINT("ELEMENT: "); EL ← CVD(INCHWL);
PRINT("LINE: "); LN←CVD(INCHWL);
PRINT("CURSOR ON? ");
IF EQU(INCHWL,"y") THEN BEGIN
CONTROL_BITS ← ZCURSON;
PRINT("BLINKING? ");
IF EQU(INCHWL,"y") THEN
CONTROL_BITS ← CONTROL_BITS LOR ZCURSBLINK;
END;
PRINT("WRAPAROUND? ");
IF EQU(INCHWL,"n") THEN CONTROL_BITS ← CONTROL_BITS LOR BLANKING;
ZOOM_PAN(CHAN, ZF, EL, LN, CONTROL_BITS);
BUFOUT;
END
ELSE IF EQU(COMMAND,"m") THEN comment Load lookup table to view LSBs;
BEGIN
INTEGER ARRAY TMAP[0:255];
INTEGER CARD, TABL, I, BITMASK, LSHIFT, NBITS;
PRINT("CARD: "); CARD ← CVO(INCHWL);
PRINT("TABLE: "); TABL ← CVO(INCHWL);
PRINT("NUMBER OF BITS: "); NBITS ← CVD(INCHWL);
BITMASK ← 2↑NBITS - 1; Comment mask with low NBITS on;
LSHIFT ← 8 - NBITS; Comment how far to shift the low NBITS;
FOR I ← 0 TO 255 DO TMAP[I] ← (I LAND BITMASK) LSH LSHIFT;
IFVCMAP(CARD, TABL, TMAP);
BUFOUT;
END
ELSE IF EQU(COMMAND,"rl") THEN comment Test lookup table with random data;
BEGIN
INTEGER ARRAY TMAP[0:255], RBACK[0:255];
INTEGER CARD, TABL, I, BITMASK, LSHIFT, NBITS;
BOOLEAN HDR;
PRINT("CARD: "); CARD ← CVO(INCHWL);
PRINT("TABLE: "); TABL ← CVO(INCHWL);
FOR I ← 0 TO 255 DO TMAP[I] ← RAN(0)*255 + 0.5;
IFVCMAP(CARD, TABL, TMAP);
BUFOUT;
GETIFVCMAP(CARD, TABL, RBACK);
HDR←FALSE;
FOR I ← 0 TO 255 DO IF TMAP[I]≠RBACK[I] THEN
BEGIN
IF NOT HDR THEN PRINT("(Octal)Location;wrote;read: ");
PRINT(CVOS(I),";",CVOS(TMAP[I]),";",CVOS(RBACK[I])," ");
HDR ← TRUE
END;
IF HDR THEN PRINT(CRLF)
END
ELSE IF EQU(COMMAND,"rmset") THEN comment Set parameters for memory test;
BEGIN
PRINT("Should test be in packed (p) or unpacked (u) mode? ");
TPACKED ← EQU(INCHWL,"p");
PRINT("Do you want random(",RND,"), all ones(",ONE,"), all zeros(",
ZRO,") or counting(",CNT,") data? ");
TDATA←CVD(INCHWL);
comment random doesn't work, but I'll have to figure it out later;
IF TDATA≠RND THEN
BEGIN
PRINT("Write the pattern?"); TWRITE←EQU(INCHWL,"y");
PRINT("Read back the pattern?"); TREAD←EQU(INCHWL,"y")
END
ELSE
BEGIN
PRINT("You can only write a random pattern.",CRLF);
TWRITE ← TRUE; TREAD ← FALSE
END;
IF TDATA=CNT THEN
BEGIN
PRINT("What is the period of the counting (in decimal)? ");
TMOD←CVD(INCHWL)
END
END
ELSE IF EQU(COMMAND,"rm") THEN comment Test memory in selected channels;
BEGIN
INTEGER E,L;
INTEGER STARTNUM,TCOUNT;
INTEGER ARRAY TLINE[0:511],RBACK[0:511];
BOOLEAN HDR;
PROCEDURE INIDATA;
BEGIN "INIDATA"
COMMENT Set things up so data can be generated;
CASE TDATA OF
BEGIN
[RND] BEGIN
STARTNUM ← RAN(0)*1000+5;
RAN(STARTNUM)
END;
[ONE][ZRO] COMMENT do nothing;
[CNT] TCOUNT←-1 COMMENT -1 because DATA increments before using;
END
END "INIDATA";
INTEGER PROCEDURE DATA;
BEGIN "DATA"
COMMENT Return the appropriate data word;
CASE TDATA OF
BEGIN
[RND] RETURN(RAN(0)*255 + 0.5); COMMENT Random data;
[ONE] RETURN('377); COMMENT All ones;
[ZRO] RETURN(0); COMMENT All zeros;
[CNT] RETURN(((TCOUNT←TCOUNT+1) MOD TMOD) MOD 256) COMMENT Counting data;
END
END "DATA";
PROCEDURE FILL_LINE;
COMMENT Fill up TLINE with generated data;
BEGIN "FILL_LINE"
FOR E ← 0 TO 511 DO TLINE[E] ← DATA
END "FILL_LINE";
PROCEDURE OUTPUT_LINE;
COMMENT Output TLINE to the current line.;
BEGIN "OUTPUT_LINE"
IF TPACKED THEN
BEGIN
GRNINS(SPD LOR BYTEUNPACK);
GRNINS(LPR LOR BYTEIMAGE LOR 0); COMMENT 256 words or 512 pixels of
image data;
FOR E ← 0 STEP 2 UNTIL 511 DO
GRNINS((TLINE[E] LSH 8) LOR TLINE[E+1])
END
ELSE
BEGIN
FOR E ← 0 TO 511 DO
GRNINS(WID LOR TLINE[E])
END
END "OUTPUT_LINE";
PROCEDURE CHECK_LINE;
COMMENT Input a line from the Grinnell and verify it against TLINE;
BEGIN "CHECK_LINE"
IF TPACKED THEN
BEGIN "PACKED READ"
GRNIN(LOCATION(RBACK[0]),256,BYTEPACK);
FOR E ← 510 STEP -2 UNTIL 0 DO
BEGIN "UNPACK THE DATA"
RBACK[E+1] ← RBACK[E DIV 2] LAND '377;
RBACK[E] ← RBACK[E DIV 2] LSH -8
END "UNPACK THE DATA"
END "PACKED READ"
ELSE
GRNIN(LOCATION(RBACK[0]),512);
FOR E ← 0 TO 511 DO
IF RBACK[E]≠TLINE[E] THEN
BEGIN "PRINT ERROR MESSAGE"
IF NOT HDR THEN PRINT("(Octal)Line;element;wrote;read: ");
PRINT(CVOS(L),";",CVOS(E),";",CVOS(TLINE[E]),";",CVOS(RBACK[E])," ");
HDR←TRUE
END "PRINT ERROR MESSAGE"
END "CHECK_LINE";
GRNINS(LSM LOR '377); COMMENT THIS MUST BE DONE FOR MEM TEST!!!;
IF TWRITE THEN BEGIN "WRITE THE PATTERN"
GRNINS(LEA LOR 0); GRNINS(LLA LOR 0); COMMENT start at lower left corner;
GRNINS(LEB LOR 1); COMMENT element increment;
GRNINS(LLB LOR 1); COMMENT line increment;
GRNINS(LEC LOR 0); COMMENT element start pos.;
GRNINS(LUM LOR E1); COMMENT update el after each write;
GRNINS(LWM LOR BITZ); COMMENT zero unused subchannels;
INIDATA;
FOR L ← 0 TO 511 DO COMMENT for 512 lines;
BEGIN
FILL_LINE;
OUTPUT_LINE;
GRNINS(SLU LOR L1 LOR E0); COMMENT incr line by 1, set el←0;
END;
BUFOUT;
END "WRITE THE PATTERN";
IF TREAD THEN BEGIN "READ THE PATTERN"
GRNINS(LEA LOR 0); GRNINS(LLA LOR 0); COMMENT start at lower left corner;
GRNINS(LEB LOR 1); COMMENT el incr;
GRNINS(LLB LOR 1); COMMENT line increment;
GRNINS(LEC LOR 0); COMMENT element start pos.;
GRNINS(LUM LOR E1); COMMENT update el after each byte;
GRNINS(SPD LOR READBACK);
HDR←FALSE;
INIDATA;
FOR L ← 0 TO 511 DO COMMENT for each line, read it and check it;
BEGIN
FILL_LINE;
CHECK_LINE;
GRNINS(SLU LOR L1 LOR E0); COMMENT Incr line by 1, reset el.;
END;
IF HDR THEN PRINT(CRLF) ELSE PRINT("Readback went OK.",CRLF)
END "READ THE PATTERN";
END
ELSE IF EQU(COMMAND,"mapin") THEN comment Read back lookup table;
BEGIN
INTEGER ARRAY TMAP[0:255];
INTEGER CARD, TABL, I;
PRINT("CARD: "); CARD ← CVO(INCHWL);
PRINT("TABLE: "); TABL ← CVO(INCHWL);
GETIFVCMAP(CARD, TABL, TMAP);
PRINT("TABLE OF CONTENTS",CRLF);
FOR I ← 0 TO 255 DO BEGIN
IF (I MOD 16) = 0 THEN PRINT(CRLF,I,": ");
PRINT(TMAP[I]," ");
END;
END
ELSE IF EQU(COMMAND,"ipcmap") THEN comment Read back ipc lookup table;
BEGIN
INTEGER ARRAY TMAP[0:1023];
INTEGER MEM, I,SIZE;
PRINT("MEMORY: "); MEM ← CVO(INCHWL);
GETIPCMAP(MEM, TMAP);
SIZE ← IF MEM = 4 THEN 1023 ELSE 255;
PRINT("Function memory contents",CRLF);
FOR I ← 0 TO SIZE DO BEGIN
IF (I MOD 16) = 0 THEN PRINT(CRLF,I,": ");
PRINT(TMAP[I]," ");
END;
END
ELSE IF EQU(COMMAND,"b") THEN comment Load lookup table to view one bit;
BEGIN
INTEGER ARRAY TMAP[0:255];
INTEGER CARD, TABL, I, BITMASK, BIT;
PRINT("CARD: "); CARD ← CVO(INCHWL);
PRINT("TABLE: "); TABL ← CVO(INCHWL);
PRINT("WHICH BIT (0-7): "); BIT ← CVD(INCHWL);
BITMASK ← 2↑BIT; Comment mask with BIT on;
FOR I ← 0 TO 255 DO TMAP[I]←IF (I LAND BITMASK)≠0 THEN '377 ELSE 0;
IFVCMAP(CARD, TABL, TMAP);
BUFOUT;
END
ELSE IF EQU(COMMAND,"k") THEN comment Read back cursor registers;
BEGIN
INTEGER CURSNO, ELEMENT, LINE; BOOLEAN FUNA, FUNB, ENTERFLAG;
PRINT("CURSOR NUMBER: "); CURSNO ← CVD(INCHWL);
GINQUIRE_CURSOR(CURSNO, ELEMENT, LINE, FUNA, FUNB, ENTERFLAG);
PRINT("ELEMENT = ",ELEMENT," LINE = ",LINE," FUNA = ",FUNA,
" FUNB = ", FUNB, " ENTERFLAG = ",ENTERFLAG,CRLF);
END
ELSE IF EQU(COMMAND,"kloop") THEN comment Repeat readback of cursor registers until FUNA and FUNB both set;
BEGIN
INTEGER CURSNO, ELEMENT, LINE; BOOLEAN FUNA, FUNB, ENTERFLAG,
times;
PRINT("CURSOR NUMBER: "); CURSNO ← CVD(INCHWL);
DO Begin
GINQUIRE_CURSOR(CURSNO, ELEMENT, LINE, FUNA, FUNB, ENTERFLAG);
IF (times mod 50) = 0 THen
PRINT("ELEMENT = ",ELEMENT," LINE = ",LINE," FUNA = ",FUNA,
" FUNB = ", FUNB, " ENTERFLAG = ",ENTERFLAG,CRLF);
times ← times + 1;
END Until funb and funa;
END
ELSE IF EQU(COMMAND,"candy") THEN comment pant, drool;
BEGIN
INTEGER CHAN, ZF, ELEMENT, LINE; BOOLEAN FUNA, FUNB, ENTERFLAG;
BOOLEAN FINISHED;
PRINT("Channel: "); CHAN ← CVD(INCHWL);
FINISHED ← FALSE;
WHILE NOT FINISHED DO
BEGIN
GINQUIRE_CURSOR(2, ELEMENT, LINE, FINISHED,FUNB, ENTERFLAG);
GINQUIRE_CURSOR(1,ELEMENT,LINE,FUNA,FUNB,ENTERFLAG);
print("Type return:"); inchwl; enterflag←true;
IF ENTERFLAG THEN
BEGIN
ZF←(IF FUNA THEN 2 ELSE 0)+(IF FUNB THEN 1 ELSE 0);
ZOOM_PAN(CHAN,ZF,2*ELEMENT,2*LINE,BLANKING);
BUFOUT
END
END
END
ELSE IF EQU(COMMAND,"d") THEN comment Digitize;
BEGIN
INTEGER SHIFT, THRESHOLD, CONTROL_BITS, NFRAMES, DATASET, DATAMODE;
STRING YN;
CONTROL_BITS ← 0;
PRINT("SHIFT: "); SHIFT ← CVD(INCHWL);
PRINT("CONTINUOUS (y or n): ");
IF EQU(INCHWL,"y") THEN CONTROL_BITS ← CONTINUOUS
ELSE BEGIN PRINT("FRAMES: "); NFRAMES ← CVD(INCHWL); END;
PRINT("THRESHOLD MODE (y or n)? ");
IF EQU(INCHWL, "y") THEN BEGIN
CONTROL_BITS ← CONTROL_BITS LOR TMODE;
PRINT("THRESHOLD: "); THRESHOLD ← CVD(INCHWL);
END ELSE THRESHOLD ← 0;
PRINT("ARITHMETIC MODE (0 - REPLACE, 1 - ADD, 2 - SUB,
3 - RECURSEIVE): ");
DATAMODE ← CVO(INCHWL) LAND '3;
IF DATAMODE ≠ 0 THEN BEGIN
PRINT("ARITHMETIC DATA SET: "); DATASET ← CVO(INCHWL) LAND '3;
END ELSE DATASET ← 0;
CONTROL_BITS ← CONTROL_BITS LOR DATAMODE LSH 9;
DIGITIZE(THRESHOLD,SHIFT, NFRAMES, CONTROL_BITS, DATASET);
bufout;
END
ELSE IF EQU(COMMAND,"p") THEN comment Test individual bit planes;
BEGIN
INTEGER ARRAY TMAP[0:255];
INTEGER CARD, TABL, I, BITMASK, BIT;
PRINT("CHAN: "); CHAN ← 2↑CVD(INCHWL);
PRINT("TABLE: "); TABL ← CVO(INCHWL);
PRINT("CARD: "); CARD ← CVO(INCHWL);
GRNINS(LDC LOR CHAN);
FOR BIT ← 0 TO 7 DO BEGIN
BITMASK ← 2↑BIT; Comment mask with BIT on;
FOR I ← 0 TO 255 DO TMAP[I]←IF (I LAND BITMASK)≠0 THEN '377 ELSE 0;
IFVCMAP(CARD, TABL, TMAP);
PRINT("CHAN " ,CHAN," BIT ",BIT,CRLF);
GRNINS(LSM LOR BITMASK);
CHEKER(TRUE); INCHWL; CHEKER(FALSE); INCHWL;
BUFOUT;
END;
END
ELSE IF EQU(COMMAND,"move") THEN comment Move cursor;
BEGIN
INTEGER CURSNO, EL, LN;
PRINT("CURSOR NUMBER: "); CURSNO ← CVD(INCHWL);
PRINT("ELEMENT: "); EL ← CVD(INCHWL);
PRINT("LINE: "); LN←CVD(INCHWL);
PRINT("RELATIVE OR ABSOLUTE (r or a): ");
IF EQU(INCHWL,"r") THEN GREL_SET_CURSOR(CURSNO, EL, LN)
ELSE GABS_SET_CURSOR(CURSNO, EL, LN);
BUFOUT;
END
ELSE IF EQU(COMMAND,"g") THEN comment Graph intensity distribution;
BEGIN
INTEGER SOURCE, HISTORY, BITS, I;
INTEGER ARRAY COUNTS[0:255];
PRINT("SOURCE NO(0-3): "); SOURCE ← CVO(INCHWL);
PRINT("READBACK MODE",crlf,
"(0: lsbits, 1: msbits, 2: min 3: max): ");
BITS ← CVO(INCHWL) LSH 10;
PRINT("HISTOGRAM MODE ",crlf," (0: no display,",
"1-6: bits (n-1)*2 - (n-1)*2 + 7, 7: bits 0-17 in semilog):");
HISTORY ← CVO(INCHWL);
GDISTRIBUTION(SOURCE, COUNTS, 0, 256, BITS,HISTORY);
BUFOUT;
PRINT("TABLE OF CONTENTS",CRLF,"0: ");
FOR I ← 0 TO 255 DO BEGIN
IF (I MOD 16) = 0 THEN PRINT(CRLF,I,": ");
PRINT(COUNTS[I]," ");
END;
END
ELSE IF EQU(COMMAND,"a") THEN comment Test max min logic of analyzer;
BEGIN
INTEGER SOURCE, MAXIMUM, MINIMUM;
PRINT("Source no.(0-4): "); SOURCE ← CVO(INCHWL);
MAXMIN(SOURCE, MAXIMUM, MINIMUM);
PRINT("Maximum = ",MAXIMUM, " Minimum = ", MINIMUM,CRLF);
END
ELSE IF EQU(COMMAND,"ah") THEN comment Print out nonzero values using
image analyzer to find them;
BEGIN
INTEGER SOURCE,I;
INTEGER ARRAY COUNTS[0:255];
PRINT("Source no(0-4): "); SOURCE ← CVO(INCHWL);
GHISTOGRAM(SOURCE,COUNTS);
FOR I ← 0 STEP 1 UNTIL 255 DO
IF COUNTS[I]≠0 THEN PRINT(I,":",COUNTS[I],CRLF)
END
ELSE IF EQU(COMMAND,"w") THEN comment Do LWM instruction;
BEGIN
STRING FOO;
PRINT("Dark background? "); FOO ← INCHWL;
GRNINS(LWM LOR (IF EQU(FOO,"y") THEN 0 ELSE BITB));
END
ELSE IF EQU(COMMAND,"ipcs") THEN comment Switch inputs to ipc lookup tables;
BEGIN
INTEGER SOURCE0, SOURCE1, SOURCE2, SOURCE3, AUXILIARY;
PRINT("SOURCE0: "); SOURCE0 ← CVO(INCHWL);
PRINT("SOURCE1: "); SOURCE1 ← CVO(INCHWL);
PRINT("SOURCE2: "); SOURCE2 ← CVO(INCHWL);
PRINT("SOURCE3: "); SOURCE3 ← CVO(INCHWL);
PRINT("Auxiliary input? ");
IF EQU(INCHWL,"y") THEN AUXILIARY ← 1;
IPCSWITCH(SOURCE0, SOURCE1, SOURCE2, SOURCE3, AUXILIARY);
BUFOUT;
END
ELSE IF EQU(COMMAND,"ipcc") THEN comment IPC control;
BEGIN
INTEGER REGISTER, CONTROL_BITS;
PRINT("Register (6 or 7): "); REGISTER ← CVO(INCHWL);
PRINT("CONTROL BITS: "); CONTROL_BITS ← CVO(INCHWL);
IPCCONTROL(REGISTER, CONTROL_BITS);
BUFOUT;
END
ELSE IF EQU(COMMAND,"ipcm") THEN comment Set IPC control mode;
BEGIN
PRINT("CONTROL BITS: ");
IPCCTRLMODE(CVO(INCHWL));
BUFOUT;
END
ELSE IF EQU(COMMAND,"ipcw") THEN comment Cause ipc to write into memory;
BEGIN
INTEGER CHAN_ENABLES;
PRINT("CHAN MASK: "); CHAN_ENABLES ← CVO(INCHWL);
PRINT("WRITE MODE (0-3): ");
IPCWRITE(CHAN_ENABLES, CVO(INCHWL));
BUFOUT;
END
ELSE IF EQU(COMMAND,"out") THEN comment Change output from look up tables;
BEGIN
INTEGER CARD, BYPASSMAP, INVERTMAP, CLAMPMAP, OVERLAYMAP;
PRINT("CARD: "); CARD←CVO(INCHWL);
PRINT("BYPASS MAP: "); BYPASSMAP ← CVO(INCHWL);
PRINT("INVERT MAP: "); INVERTMAP ← CVO(INCHWL);
PRINT("CLAMP MAP: "); CLAMPMAP ← CVO(INCHWL);
PRINT("OVERLAY MAP: "); OVERLAYMAP ← CVO(INCHWL);
IFVCOUTPUT(CARD, BYPASSMAP, INVERTMAP, CLAMPMAP, OVERLAYMAP);
BUFOUT;
END
ELSE IF EQU(COMMAND,"cout") THEN comment Change cursor oerlay map;
BEGIN
INTEGER CARD, BYPASSMAP, INVERTMAP, CLAMPMAP, OVERLAYMAP;
PRINT("CARD: "); CARD←CVO(INCHWL);
PRINT("BYPASS MAP: "); BYPASSMAP ← CVO(INCHWL);
PRINT("INVERT MAP: "); INVERTMAP ← CVO(INCHWL);
PRINT("CLAMP MAP: "); CLAMPMAP ← CVO(INCHWL);
PRINT("OVERLAY MAP: "); OVERLAYMAP ← CVO(INCHWL);
IFVCURSORMAP(CARD, BYPASSMAP, INVERTMAP, CLAMPMAP, OVERLAYMAP);
BUFOUT;
END
ELSE IF EQU(COMMAND,"ck") THEN comment Clear all channels, make drk bkg, draw checkerboard;
BEGIN
GRNINS(LDC LOR '7777);
GRNINS(LSM LOR '7777);
GRNINS(LWM LOR 0);
GRNINS(ERS);
GRNINS(LDC LOR '377);
GRNINS(LSM LOR '377);
CHEKER(TRUE);
END
ELSE IF EQU(COMMAND,"bump") THEN comment Repetitive interface exercise;
BEGIN
PRINT("This test requires the GRIND program to be running on the
PDP-11. If it not already running, start it now.
");
GRNINS(LDC LOR '7777);
GRNINS(LSM LOR '7777);
GRNINS(LWM LOR 0);
GRNINS(ERS);
GRNINS(LDC LOR '377);
GRNINS(LSM LOR '377);
CHEKER(TRUE);
PRINT("Type return to start the exercise: "); INCHWL;
ELFOUT('400,1); Comment Set lock to 1;
PRINT("Type return to stop the exercise: "); INCHWL;
ELFOUT('400,0);
END
ELSE IF EQU(COMMAND,"fill") THEN comment Fill buffer with bytes do packed mode output to grinnel;
BEGIN "FILL"
INTEGER TOP, LEFT;
PRINT("TOP: "); TOP ← CVD(INCHWL);
PRINT("LEFT: "); LEFT ← CVD(INCHWL);
GRNINS(LDC LOR CHAN); Comment Select channel;
GRNINS(LWM LOR BITZ); Comment Set write mode;
GRNINS(LUM LOR E1); Comment Ea ← Ea+Eb mode;
GRNINS(LEB LOR 1); Comment Eb ← 1;
GRNINS(LLB LOR NEG1); Comment Lb ← -1;
GRNINS(LLA LOR TOP); Comment La ← top margin;
GRNINS(LEC LOR LEFT); Comment Ec ← left margin;
GRNINS(LEA LOR LEFT); Comment Set Ea to starting value;
BEGIN "PACKOUT"
INTEGER I,J,LINELEN, REPEAT; Comment temp;
COMMENT LINELEN - how many bytes to output (MAXPACK is maximum);
INTEGER B1,B2; Comment Data bytes output;
PRINT("REPEAT COUNT: "); REPEAT ← CVD(INCHWL);
PRINT("LINELEN: "); LINELEN ← CVD(INCHWL);
IF LINELEN > MAXPACK THEN LINELEN ← MAXPACK;
PRINT("word 1: "); B1 ← CVO(INCHWL);
PRINT("word 2: "); B2 ← CVO(INCHWL);
FOR J ← 1 STEP 1 UNTIL REPEAT DO BEGIN
GRNINS(SPD LOR BYTEUNPACK); Comment Set up data packing;
GRNINS(LPR LOR BYTEIMAGE LOR (TRUNC*(LINELEN MOD 2))
LOR (((LINELEN+1) DIV 2) MOD (MAXPACK DIV 2)) );
Comment 0 len means max;
FOR I ← 1 STEP 4 UNTIL LINELEN DO BEGIN
GRNINS(B1);
GRNINS(B2);
END;
GRNINS(SLU LOR L1 LOR E0); Comment Return to left margin and next line
(this is La ← La+Lb and Ea ← Ec);
END;
END "PACKOUT";
BUFOUT;
END "FILL"
ELSE IF EQU(COMMAND,"rect") THEN Comment use rectangular update mode for output;
BEGIN
INTEGER TOP, LEFT, BOTTOM, RIGHT;
PRINT("TOP: "); TOP ← CVD(INCHWL);
PRINT("LEFT: "); LEFT ← CVD(INCHWL);
PRINT("BOTTOM: "); BOTTOM ← CVD(INCHWL);
PRINT("RIGHT: "); RIGHT ← CVD(INCHWL);
GRNINS(LWM LOR RECTNG); ! Use rectangular update mode;
GRNINS(LLA LOR BOTTOM); ! Starting at the bottom;
GRNINS(LEA LOR LEFT); ! left hand corner;
GRNINS(LLB LOR ((TOP-BOTTOM) land '777)); ! ending at the top;
GRNINS(LEB LOR ((RIGHT-LEFT) land '777)); ! right hand corner;
PRINT("VERTICALLY?");
IF EQU(INCHWL,"y") THEN GRNINS(LUM LOR L0) ! Write vertically;
ELSE GRNINS(LUM LOR E0); ! Write horizontally first;
BEGIN
INTEGER I,J,LINELEN, REPEAT; Comment temp;
COMMENT LINELEN - how many bytes to output (MAXPACK is maximum);
INTEGER B1,B2; Comment Data bytes output;
REPEAT ← ABS(TOP-BOTTOM);
LINELEN ← RIGHT-LEFT;
IF LINELEN > MAXPACK THEN LINELEN ← MAXPACK;
PRINT("word 1: "); B1 ← CVO(INCHWL);
PRINT("word 2: "); B2 ← CVO(INCHWL);
FOR J ← 0 STEP 1 UNTIL REPEAT DO BEGIN
IFC FALSE THENC
GRNINS(SPD LOR BYTEUNPACK); Comment Set up data packing;
GRNINS(LPR LOR BYTEIMAGE LOR (TRUNC*(LINELEN MOD 2))
LOR (((LINELEN+1) DIV 2) MOD (MAXPACK DIV 2)) );
Comment 0 len means max;
ENDC
FOR I ← 0 STEP 2 UNTIL LINELEN DO BEGIN
GRNINS(B1);
GRNINS(B2);
END;
END;
END;
BUFOUT;
END
ELSE IF EQU(COMMAND,"!") THEN comment Print commands, listed by unit affected;
print("Arbitrary instructions
o
Cursor
k,kloop,move
Digitizer
d
Image analyzer
a,g,ah
Image processor
ipcc,ipcm,ipcs,ipcw
Internal tests
i,t,t0,t1,t2,t3
Lookup tables
b,kludge,m,mapin,out,rl,s
Memory
p,rm,rmset
Picture display
c,ck,e,fill,l,pw,r,rect,set,w
Picture readback
bump,loopp,looprp,pr or ;,uset,u
Zoom/pan
z
")
ELSE IF EQU(COMMAND,"?") THEN comment Print help message;
print("a Test max min logic of analyzer
ah Print nonzero counts in distribution using image analyzer
b Load lookup table to view one bit
bump Control repetitive packed readback test
c Checkerboard pattern
ck Clear all channels, make drk bkg, draw checkerboard
d Digitize
e Erase current channel
fill fill enabled channels in packed mode
g Graph intensity distribution
i Select the internal tests, but don't run any
ipcc IPC control
ipcm Set IPC control mode
ipcmap Read back lookup table of ipc function memory
ipcs Switch inputs to ipc lookup tables
ipcw Cause ipc to write into memory
kludge Test bit map flaw
loopp Do a packed read 101 times
looprp Do a packed read with bytes reveresed 101 times
k Read back cursor registers
kloop Repeat readback of cursor registers until FUNA and FUNB both set
l Load channel and subchannel
m Load lookup table to view LSBs
mapin Read back lookup table
move Move cursor
o Output an octal instruction
out Change output from look up tables
p Test individual bit planes
pr or ; Do a packed read
pw Do a packed write
q Quit
r Reverse checkerboard patten
rect use rectangular update for output
rl Test lookup table with random data
rm Test selected channel
rmset Set parameters for memory test
s Set inputs to video lookup tables
set Load several channels and subchannels
t Run the four internal tests
t0,t1,t2,t3 Run one of the internal tests
uset Set parameters for u and pr command
u Do an unpacked read
w Do LWM instruction
z Check zoom and pan
? Print help message
! Print commands, listed by unit affected
")
ELSE IF EQU(COMMAND,"q") THEN FINISHED ← TRUE
ELSE PRINT("Type ? for help.",crlf);
END;
GRNFIN;
END "TEST2"